home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1993…ch: Other People's Memory / ADC Developer CD (1993-03) (''Other People's Memory'')_iso / Dev.CD Mar 93.iso / Development Platforms / LISP Related / LISP Goodies / McCartney-library 1.1 / CODE / misc / perspective-projection.lisp < prev   
Encoding:
Text File  |  1992-09-02  |  3.9 KB  |  112 lines  |  [TEXT/CCL2]
  1. ;;; perspective-projection.lisp
  2. ;;;
  3. ;;; Paul McCartney, Spring 1992
  4. ;;;
  5. ;;; Copyright © 1992 Paul McCartney.  All Rights Reserved.
  6. ;;; 
  7. ;;; Washington University Medical Informatics Training Program
  8. ;;;
  9. ;;; DESCRIPTION:
  10. ;;;
  11. ;;; This provides code for displaying 3D objects using simple perspective
  12. ;;; projection.  Images are projected onto the z=0 plane from an 
  13. ;;; observer's point of view at some distance from the plane.
  14. ;;;
  15. ;;; USE:
  16. ;;;
  17. ;;; perspective-projection   - class for 3D images
  18. ;;;   :distance              - viewer distance from the z=0 plane
  19. ;;;   :view-3D-origin        - 2D view coordinate of the 3D origin (i.e. (0, 0, 0))
  20. ;;; 
  21. ;;; perspective-make-point   - make 2D real view point from 3D point
  22. ;;; view-point-to-3D         - given a real view point, translate it into
  23. ;;;                            a 3D point (x, y) at the plane z=0
  24. ;;; draw-block-below-horizon - draw a brick-shaped object in 3D
  25. ;;;
  26. ;;; HISTORY:
  27. ;;;
  28. ;;; 6/20/92 Created.  - PM
  29. ;;;
  30.  
  31. (in-package :ccl)
  32.  
  33. (require :quickdraw)
  34. (require :graphics-tools)
  35.  
  36. (eval-when (:compile-toplevel :load-toplevel :execute)
  37.   (export '(perspective perspective-make-point view-point-to-3D 
  38.             draw-block-below-horizon)
  39.           :ccl))
  40.  
  41.  
  42. (defstruct perspective
  43.   (distance 100 :type fixnum)
  44.   (view-3D-origin #@(0 0) :type fixnum) )
  45.  
  46.  
  47. (defun perspective-make-point (p x y &optional z)
  48.   (let* ((x1 (if z x (point-h x)))
  49.          (y1 (if z y (point-v x)))
  50.          (z1 (if z z y))
  51.          (d1 (+ (perspective-distance p) z1))
  52.          (x2 (+ (round (* (perspective-distance p) x1) d1) 
  53.                 (point-h (perspective-view-3D-origin p))))
  54.          (y2 (+ (round (* (perspective-distance p) y1) d1) 
  55.                 (point-v (perspective-view-3D-origin p)))))
  56.     (make-point x2 y2)))
  57.  
  58.  
  59. (defun view-point-to-3D (p point)
  60.   (let* ((x (point-h point))
  61.          (y (point-v point)))
  62.     (make-point (- x (point-h (perspective-view-3D-origin p)))
  63.                 (- y (point-v (perspective-view-3D-origin p))))))
  64.          
  65.  
  66. (defmethod draw-block-below-horizon ((view simple-view) p topleft bottomright color depth)
  67.   (let* ((p1 (view-point-to-3D p topleft))
  68.          (p4 (view-point-to-3D p bottomright))
  69.          (p2 (make-point (point-h p4) (point-v p1)))
  70.          (p3 (make-point (point-h p1) (point-v p4)))
  71.          (vp1 (perspective-make-point p p1 0))
  72.          (vp2 (perspective-make-point p p2 0))
  73.          (vp3 (perspective-make-point p p3 0))
  74.          (vp4 (perspective-make-point p p4 0))
  75.          (vp5 (perspective-make-point p p1 depth))
  76.          (vp6 (perspective-make-point p p2 depth))
  77.          (vp7 (perspective-make-point p p3 depth))
  78.          (vp8 (perspective-make-point p p4 depth))
  79.          (front-color color)
  80.          (top-color (change-brightness color 1.1))
  81.          (side-color (change-brightness color 1.4))
  82.          (outline-color (change-brightness color 2))
  83.          (front-poly (make-polygon-shape view vp1 vp2 vp4 vp3 vp1))
  84.          (top-poly (make-polygon-shape view vp1 vp2 vp6 vp5 vp1))
  85.          (side-left-poly (make-polygon-shape view vp2 vp6 vp8 vp4 vp2))
  86.          (side-right-poly (make-polygon-shape view vp1 vp5 vp7 vp3 vp1)))
  87.  
  88.     (with-focused-view view
  89.       (with-fore-color side-color
  90.         (paint-polygon view side-left-poly))
  91.       (with-fore-color outline-color
  92.         (frame-polygon view side-left-poly))
  93.       (with-fore-color side-color
  94.         (paint-polygon view side-right-poly))
  95.       (with-fore-color outline-color
  96.         (frame-polygon view side-right-poly))
  97.       (with-fore-color front-color
  98.         (paint-polygon view front-poly))
  99.       (with-fore-color outline-color
  100.         (frame-polygon view front-poly))
  101.       (with-fore-color top-color
  102.         (paint-polygon view top-poly))
  103.       (with-fore-color outline-color
  104.         (frame-polygon view top-poly)))
  105.     
  106.     (kill-polygon front-poly)
  107.     (kill-polygon top-poly)
  108.     (kill-polygon side-left-poly)
  109.     (kill-polygon side-right-poly) ))
  110.  
  111.  
  112. (provide :perspective-projection)